{ *********************************************************** }
{ *                    ksTools Library                      * }
{ *       Copyright (c) Sergey Kasandrov 1997, 2010         * }
{ *       -----------------------------------------         * }
{ *         http://sergworks.wordpress.com/kstools          * }
{ *********************************************************** }

unit TestCompress;
{

  Delphi DUnit Test Case
  ----------------------
  This unit contains a skeleton test case class generated by the Test Case Wizard.
  Modify the generated code to correctly setup and call the methods from the unit
  being tested.

}

interface

uses
  TestFramework, Windows, Forms, Dialogs, Controls, Classes, SysUtils, Variants,
  Graphics, Messages, ksUtils, ksCompress;

type
  TTestCompress = class(TTestCase)
  private
    procedure CheckEqualBytes(const A, B: TBytes; const Comment: string = '');
    procedure TestShrinkString(const S: string);
  protected
    procedure SetUp; override;
  published
    procedure TestShrinkA;
    procedure TestShrinkFile;
  end;

implementation

function StringToBytes(const S: string): TBytes;
var
  I: Integer;

begin
  SetLength(Result, Length(S));
  for I:= 0 to Length(S) - 1 do begin
    Result[I]:= Byte(S[I + 1]);
  end;
end;

function CRC32Stream(AStream: TStream): LongWord;
var
  Count: Integer;
  B: Byte;

begin
  Count:= AStream.Seek(0, soFromEnd);
  AStream.Seek(0, soFromBeginning);
  Result:= $FFFFFFFF;
  while Count > 0 do begin
    AStream.ReadBuffer(B, 1);
    Result:= CRC32OfByte(B, Result);
    Dec(Count);
  end;
end;

{ TestCompress }

procedure TTestCompress.CheckEqualBytes(const A, B: TBytes;
  const Comment: string);
var
  I: Integer;

begin
  CheckEquals(Length(A), Length(B),
      Format('%s Length: %d -- %d', [Comment, Length(A), Length(B)]));
  for I:= 0 to Length(A) - 1 do
    CheckEquals(Cardinal(A[I]), Cardinal(B[I]),
      Format('%s Data[%d]: %.4x -- %.4x', [Comment, I, A[I], B[I]]));
end;

procedure TTestCompress.TestShrinkA;
begin
  TestShrinkString('abraabracadabra');
end;

procedure TTestCompress.TestShrinkFile;
var
  OriginalStream,
  CompressedStream,
  UnCompressedStream: TStream;
  Size, NewSize: Integer;
  CRC, NewCRC: LongWord;

begin
  OriginalStream:= TFileStream.Create('CompressTests.exe',
                                       fmOpenRead or fmShareDenyNone);
  try
    Size:= OriginalStream.Size;
    CompressedStream:= TMemoryStream.Create;
    try
      ShrinkStream(OriginalStream, CompressedStream, Size);
      CompressedStream.Seek(0, soFromBeginning);
      UnCompressedStream:= TMemoryStream.Create;
      try
        UnshrinkStream(CompressedStream, UncompressedStream, Size);
        NewSize:= UncompressedStream.Size;
        CheckEquals(Size, NewSize, Format('Size: %d -- %d', [Size, NewSize]));
        CRC:= CRC32Stream(OriginalStream);
        NewCRC:= CRC32Stream(UncompressedStream);
        CheckEquals(CRC, NewCRC, Format('Size: %.8x -- %.8x', [CRC, NewCRC]));
      finally
        UnCompressedStream.Free;
      end;
    finally
      CompressedStream.Free;
    end;
  finally
    OriginalStream.Free;
  end;
end;

procedure TTestCompress.TestShrinkString(const S: string);
var
  OriginalBytes,
  CompressedBytes,
  UnCompressedBytes: TBytes;

begin
  OriginalBytes:= StringToBytes(S);
  CompressedBytes:= ShrinkBytes(OriginalBytes);
  UnCompressedBytes:= UnshrinkBytes(CompressedBytes, Length(OriginalBytes));
  CheckEqualBytes(OriginalBytes, UncompressedBytes);
end;

procedure TTestCompress.SetUp;
begin

end;

initialization
  // Register any test cases with the test runner
  RegisterTest(TTestCompress.Suite);
end.

